REM *****************************************

REM *******  2DFFT 13.00 - 2D XFORM   *******

REM *****************************************

10 SCREEN 9, 1, 1: COLOR 15, 1

12 GOSUB 10000

14 INPUT "SELECT ARRAY SIZE AS 2^N.  N ="; N

16 Q = 2 ^ N

18 ' $DYNAMIC

20 DIM C(2, Q, Q), S(2, Q, Q), KC(Q), KS(Q), DA1(Q, Q)

22 Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4: Q5 = Q4 - 1: Q8 = Q / 8: ANP = 0

24 PI = 3.141592653589793#: PI2 = 2 * PI: K1 = PI2 / Q: CLVK = 1

26 FOR I = 0 TO Q: KC(I) = COS(K1 * I): KS(I) = SIN(K1 * I): NEXT

28 CLS : PRINT : PRINT : PRINT "               MAIN MENU": PRINT

30 PRINT " 1 = GENERATE FUNCTIONS": PRINT

32 PRINT " 2 = TRANSFORM FUNCTION": PRINT

34 PRINT " 3 = INVERSE TRANSFORM ": PRINT

36 PRINT " 4 = EXIT              ": PRINT : PRINT

38 PRINT "            MAKE SELECTION";

40 A$ = INKEY$: IF A$ = "" THEN 40

42 A = VAL(A$): ON A GOSUB 5000, 50, 80, 9999, 120

GOTO 28



REM **********************************************

REM *              XFORM FUNCTION                *

REM **********************************************

50 CLS ' CLEAR SCREEN

52 FOR I = 0 TO Q - 1: FOR J = 0 TO Q - 1: C(T0, I, J) = 0: S(T0, I, J) = 0: NEXT J: NEXT I

54 K6 = -1: SK1 = 2: XDIR = 1: T9 = TIMER

56 GOSUB 200 ' DO FORWARD 2-D XFORM

58 T9 = TIMER - T9 ' CHECK TIME

60 GOSUB 140 ' DISPLAY DATA

62 PRINT : INPUT "ENTER TO CONTINUE"; A$ ' WAIT

64 RETURN



REM **********************************************

REM *            INVERSE TRANSFORM               *

REM **********************************************

80 CLS : K6 = 1: SK1 = 1: XDIR = 0: T9 = TIMER

82 GOSUB 200: REM RECONSTRUCT 2-D XFORM

84 T9 = TIMER - T9 ' GET TIME

86 GOSUB 140 ' PLOT OUTPUT

88 PRINT : INPUT "ENTER TO CONTINUE"; A$ ' WAIT

90 RETURN



REM ********************************************************

REM *               PRINT OUTPUT

REM ********************************************************

120 CLS

PRINT "ONLY THE Q/2 ROW WILL BE PRINTED"

PRINT "SPACIAL OR FREQUENCY? (S/F)"

121 A$ = INKEY$: IF A$ = "" THEN 121

ROLOC = 0 ' ROW LOCATION

IF A$ = "S" THEN ROLOC = Q2

PRINT "SCREEN OR PRINTER (S/P)"

122 A$ = INKEY$: IF A$ = "" THEN 122

IF A$ = "S" THEN 125

IF A$ <> "P" THEN 120

FOR I = 0 TO Q - 1

Y2 = C(T1, ROLOC, I): X2 = S(T1, ROLOC, I)

Y3 = C(T1, ROLOC + 1, I): X3 = S(T1, ROLOC + 1, I)

LPRINT I;

LPRINT USING "###.######_      "; Y2; X2; Y3; X3

NEXT I

LPRINT CHR$(12)

RETURN

' **************************************************

125 CLS ' PRINT SCREEN

FOR I = 0 TO Q - 1

Y2 = C(T1, ROLOC, I): X2 = S(T1, ROLOC, I)

Y3 = C(T1, ROLOC + 1, I): X3 = S(T1, ROLOC + 1, I)

IF Y2 = 0 THEN PRINT 0, 0: GOTO 126

PRINT I;

REM PRINT USING "###.######_      "; SQR(Y2 ^ 2 + X2 ^ 2); 180 / PI * ATN(X2 / Y2)

PRINT USING "###.######_      "; Y2; X2; Y3; X3

LINCTR = LINCTR + 1: IF LINCTR > 22 THEN GOSUB 128

126 NEXT I

128 INPUT A$

LINCTR = 0

RETURN



REM **********************************************

REM *                PLOT DATA                   *

REM **********************************************

140 CLS : AMP1 = 0 ' FIND LARGEST MAGNITUDE IN ARRAY

142     FOR I = 0 TO Q - 1

144         FOR J = 0 TO Q - 1

146              IF XDIR = 0 THEN AMP = C(T1, I, J): GOTO 150

148              AMP = SQR(C(T1, I, J) ^ 2 + S(T1, I, J) ^ 2)

150              IF AMP1 < AMP THEN AMP1 = AMP

152         NEXT J

154     NEXT I

156 MAG2 = -130 / AMP1 ' SET SCALE FACTOR

158 GOSUB 6000 ' PLOT 2-D DATA

160 LOCATE 1, 1: PRINT "TIME = "; T9

162 RETURN



REM ************************************************

REM *              TRANSFORM                       *

REM ************************************************

200 CLS : KRTST = 19

202 T00 = T0: T11 = T1 ' SAVE INITIAL INPUT SIDE

204 FOR KR = 0 TO Q - 1 ' XFORM 2D ARRAY BY ROWS

206 T0 = T00: T1 = T11 ' INITIALIZE INPUT SIDE OF ARRAYS

207 IF XDIR = 1 THEN GOSUB 300

208 PRINT USING "##_ "; KR; ' PRINT ROW BEING XFORMED

210 IF KR = KRTST THEN PRINT : KRTST = KRTST + 20 ' END PRINT LINE

212 REM THE ROUTINE BELOW IS THE STANDARD FFT ROUTINE FOR A ROW

214 FOR M = 0 TO N - 1: QT = 2 ^ M: KT1 = 2 ^ (N - M - 1)

216 FOR J = 0 TO Q3 STEP QT: J1 = 2 * J: K9 = J + Q2

218 FOR I = 0 TO QT - 1: KT = I * KT1: K = K9 + I

220 IF XDIR = 1 THEN GOSUB 280 ELSE GOSUB 290

222 NEXT I

224 J1 = J1 + QT

226 FOR I = 0 TO QT - 1: KT = (I + QT) * KT1: K = K9 + I

228 IF XDIR = 1 THEN GOSUB 280 ELSE GOSUB 290

230 NEXT I: NEXT J

232 T0 = 1 - T0: T1 = 1 - T1

234 NEXT M

235 IF XDIR = 0 THEN GOSUB 330

236 NEXT KR

240 PRINT

  GOSUB 140 ' USE TO SHOW RESULTS OF ROW XFORMS

241 A$ = INKEY$: IF A$ = "" THEN 241

242 KRTST = 19

243 T11 = T1: T00 = T0

244 FOR KR = 0 TO Q - 1 ' XFORM 2D ARRAY BY COLUMNS

246 T0 = T00: T1 = T11

247 IF XDIR = 1 THEN GOSUB 330

248 PRINT USING "###_ "; KR;

250 IF KR = KRTST THEN PRINT : KRTST = KRTST + 20

252 FOR M = 0 TO N - 1: QT = 2 ^ M: KT1 = 2 ^ (N - M - 1)

254 FOR J = 0 TO Q3 STEP QT: J1 = 2 * J: K9 = J + Q2

256 FOR I = 0 TO QT - 1: KT = I * KT1: K = K9 + I

258 IF XDIR = 1 THEN GOSUB 290 ELSE GOSUB 280

260 NEXT I

262 J1 = J1 + QT

264 FOR I = 0 TO QT - 1: KT = (I + QT) * KT1: K = K9 + I

266 IF XDIR = 1 THEN GOSUB 290 ELSE GOSUB 280

268 NEXT I: NEXT J

270 T0 = 1 - T0: T1 = 1 - T1

272 NEXT M:

273 IF XDIR = 0 THEN GOSUB 300

274 NEXT KR

276 RETURN



REM THE SUBROUTINES BELOW ARE THE UNIVERSAL BUTTERFLY FUNCTIONS

280 C(T0, KR, J1 + I) = (C(T1, KR, I + J) + C(T1, KR, K) * KC(KT) - K6 * S(T1, KR, K) * KS(KT)) / SK1

282 S(T0, KR, J1 + I) = (S(T1, KR, I + J) + K6 * C(T1, KR, K) * KS(KT) + S(T1, KR, K) * KC(KT)) / SK1

284 RETURN

290 C(T0, J1 + I, KR) = (C(T1, I + J, KR) + C(T1, K, KR) * KC(KT) - K6 * S(T1, K, KR) * KS(KT)) / SK1

292 S(T0, J1 + I, KR) = (S(T1, I + J, KR) + K6 * C(T1, K, KR) * KS(KT) + S(T1, K, KR) * KC(KT)) / SK1

294 RETURN



' ****************************************

' *          MODIFY SAMPLING             *

' ****************************************

300 FOR I = 1 TO Q - 1 STEP 2

302 C(T1, KR, I) = -C(T1, KR, I): S(T1, KR, I) = -S(T1, KR, I)

304 NEXT I

306 RETURN



330 FOR I = 0 TO Q - 1 STEP 2

332 C(T1, I, KR) = -C(T1, I, KR): S(T1, I, KR) = -S(T1, I, KR)

334 NEXT I

336 RETURN



     REM *********************************

     REM *      GENERATE FUNCTIONS       *

     REM *********************************

5000 CLS : PRINT : PRINT : PRINT "               FUNCTION MENU": PRINT

5002 PRINT " 1 = GENERATE SINC^2 FUNCTION      2 = GENERATE STARS": PRINT

5004 PRINT " 3 = DIFRACTED DOUBLE STAR         4 = CIRC FUNCTION": PRINT

5006 PRINT " 5 = STRETCHED SINC^2              6 = SINC FUNCTION:": PRINT

5008 PRINT " 7 = BESSEL                        8 = EXIT:": PRINT

5010 PRINT "            MAKE SELECTION";

5012 A$ = INKEY$: IF A$ = "" THEN 5012

5014 A = VAL(A$): ON A GOTO 5030, 5100, 5200, 5300, 5400, 5500, 5600

5016 IF A = 8 THEN RETURN

5018 GOTO 5000



     REM *********************************

     REM *       SINC^2 FUNCTION         *

     REM *********************************

5030 CLS : MAG1 = Q: T1 = 0: T0 = 1

5032 INPUT "WIDTH"; WDTH1 ' INPUT FINCTION SIZE

5034 IF WDTH1 = 0 THEN WDTH1 = 1 ' ZERO INVALID

5036 SKL1 = PI2 / WDTH1: MAG1 = Q ' CALC CONSTANTS

5038 FOR I = 0 TO Q - 1 '

5040 YARG = SKL1 * (I - Q2): PRINT "*";

5042 FOR J = 0 TO Q - 1

5044 XARG = SKL1 * (J - Q2)

5046 IF YARG = 0 AND XARG = 0 THEN C(T1, I, J) = MAG1: GOTO 5052

5048 ARG = SQR(XARG ^ 2 + YARG ^ 2)

5050 C(T1, I, J) = MAG1 * (SIN(ARG) / ARG) ^ 2: S(0, I, J) = 0

5052 NEXT J

5054 NEXT I

5056 GOSUB 140 ' PLOT FUNCTION

5058 INPUT A$ ' WAIT

5060 RETURN



5100 REM ********************************

     REM *       GENERATE STARS         *

     REM ********************************

SCREEN 9, 1, 1: CLS

INPUT "NUMBER OF STARS IN X"; NXSTRS

INPUT "INPUT X SEPARATION"; XSEPR

INPUT "ROWS OF STARS"; NY

INPUT "SEPARATION BETWEEN ROWS"; YSEPR

XINI = INT((NXSTRS * (1 + XSEPR)) / 2): IF XINI < 1 THEN XINI = 1

YINI = INT((NY * (1 + YSEPR)) / 2): IF YINI < 1 THEN YINI = 1

MAG1 = Q ^ 2: T1 = 0: T0 = 1: ANM = MAG1 * ANP

FOR I = 0 TO Q - 1

FOR J = 0 TO Q - 1

C(T1, I, J) = 0: S(T1, I, J) = 0

NEXT J

NEXT I

IF SEPR > Q4 THEN 4014

REM IF NXSTRS = 1 AND NY = 1 THEN C(T1, Q2, Q2) = MAG1: GOTO 4014

REM IF NSTRS = 2 THEN C(T1, Q2, Q2 - (XINI)) = MAG1: C(T1, Q2, Q2 + XINI + SEPR) = MAG1

FOR I = 1 TO NY

FOR J = 1 TO NXSTRS

C(T1, Q2 - YINI + (I * (1 + YSEPR)), Q2 - XINI + (J * (1 + XSEPR))) = MAG1

NEXT J

NEXT I



4014 REM C(T1, Q2, (Q2)) = MAG1

MAG2 = -140 / Q ^ 2

GOSUB 140

INPUT "C/R TO CONTINUE"; A$

RETURN



REM ***********************************

5200 REM *   DIFFRACTED DOUBLE STAR   *

REM ***********************************

CLS

T1 = 0: T0 = 1

INPUT "WIDTH"; WDTH1

INPUT "SEPARATION"; SEPR1

SKL1 = PI2 / WDTH1: MAG1 = Q

FOR I = 0 TO Q - 1

YARG = SKL1 * (I - Q2): PRINT "*";

FOR J = 0 TO Q - 1

XARG = SKL1 * (J - Q2)

IF YARG = 0 AND XARG = 0 THEN C(T1, I, J) = MAG1: GOTO 5210

ARG = SQR(XARG ^ 2 + YARG ^ 2)

C(T1, I, J) = MAG1 * (SIN(ARG) / ARG) ^ 2: S(T1, I, J) = 0

5210 NEXT J

NEXT I

FOR I = 0 TO Q - 1

YARG = SKL1 * (I - Q2): PRINT "*";

FOR J = 0 TO Q - 1

XARG = SKL1 * (J - Q2 - SEPR1)

IF YARG = 0 AND XARG = 0 THEN C(T1, I, J) = C(T1, I, J) + MAG1: GOTO 5220

ARG = SQR(XARG ^ 2 + YARG ^ 2)

C(T1, I, J) = C(T1, I, J) + MAG1 * (SIN(ARG) / ARG) ^ 2

5220 NEXT J

NEXT I

GOSUB 140

INPUT A$

RETURN



5300 REM *********************************

     REM *         CIRC FUNCTION         *

     REM *********************************

CLS : MAG1 = Q: T1 = 0: T0 = 1

INPUT "DIAMETER"; DIA1

INPUT "CENTERED ON (X,Y)"; CNTRX, CNTRY

SKL1 = Q / DIA1: MAG1 = Q

FOR I = 0 TO Q - 1

YARG = I - CNTRY: PRINT "*";

FOR J = 0 TO Q - 1

XARG = J - CNTRX

C(T1, I, J) = 0

ARG = SQR(XARG ^ 2 + YARG ^ 2)

IF ARG <= DIA1 THEN C(T1, I, J) = MAG1: S(T1, I, J) = 0

5310 NEXT J

NEXT I

GOSUB 140

INPUT A$

RETURN



5400 REM *********************************

     REM *   STRETCHED SINC^2 FUNCTION   *

     REM *********************************

CLS : MAG1 = Q: T0 = 1: T1 = 0

INPUT "WIDTH"; WDTH1

SKL1 = PI2 / WDTH1: MAG1 = Q

FOR I = 0 TO Q2 - 1

YARG = SKL1 * (2 * I - Q2): PRINT "*";

FOR J = 0 TO Q2 - 1

XARG = SKL1 * (2 * J - Q2)

IF YARG = 0 AND XARG = 0 THEN C(T1, 2 * I, 2 * J) = MAG1: GOTO 5490

ARG = SQR(XARG ^ 2 + YARG ^ 2)

C(T1, 2 * I, 2 * J) = MAG1 * (SIN(ARG) / ARG) ^ 2: S(T1, I, J) = 0

5490 NEXT J

NEXT I

GOSUB 140

INPUT A$

RETURN



5500 REM *********************************

     REM *         SINC FUNCTION         *

     REM *********************************

CLS : MAG1 = Q: T0 = 1: T1 = 0

INPUT "WIDTH"; WDTH1

SKL1 = PI2 / WDTH1: MAG1 = Q

FOR I = 0 TO Q - 1

YARG = SKL1 * (I - Q2): PRINT "*";

FOR J = 0 TO Q - 1

XARG = SKL1 * (J - Q2)

IF YARG = 0 AND XARG = 0 THEN C(T1, I, J) = MAG1: GOTO 5590

ARG = SQR(XARG ^ 2 + YARG ^ 2)

C(T1, I, J) = MAG1 * (SIN(ARG) / ARG): S(T1, I, J) = 0

5590 NEXT J

NEXT I

GOSUB 140

INPUT A$

RETURN



     REM *********************************

     REM *       BESSEL FUNCTION         *

     REM *********************************

5600 CLS : DEFDBL D-K

5602 T0 = 1: T1 = 0

5604 INPUT "WIDTH"; WDTH1

5606 IF WDTH1 < 1 THEN 5604 ' MINIMUM WIDTH

5608 SKL1 = PI / (3.6 * WDTH1 * Q / 64)

5610 FOR I = 0 TO Q - 1

5612 YARG = SKL1 * (I - Q2): PRINT "*";

5614 FOR J = 0 TO Q - 1

5616 XARG = SKL1 * (J - Q2)

5618 KARG = SQR(XARG ^ 2 + YARG ^ 2)

5620 KA = 1: KB = 1: DAT1 = 1: KTGL = 1

5622 FOR K = 2 TO 900 STEP 2

5624 KTGL = -1 * KTGL

5626 KA = KA * K: KB = KB * (K + 2): DENOM = KA * KB

5628 DAT2 = KTGL * (WDTH1 ^ (K / 2) * KARG ^ K / DENOM)

5630 IF ABS(DAT2) < ABS(DAT1) * 1E-10 THEN 5640

5632 DAT1 = DAT1 + DAT2

5634 REM PRINT DAT1,

5636 NEXT K

5638 PRINT "#"

5640 C(T1, I, J) = DAT1: S(T1, I, J) = 0

5642 NEXT J

5644 NEXT I

5646 GOSUB 140

5648 INPUT A$

5650 RETURN



6000 REM *******************************

     REM *         PLOT DATA           *

     REM *******************************

CLS ' CLEAR SCREEN AND SET SCALE FACTORS

XCAL = 320 / Q: YCAL = 120 / Q: YDIS = 150

FOR I = 0 TO Q - 1 ' FOR ALL ROWS

DISP = (Q - I) * 288 / Q ' DISPLACE ROWS FOR 3/4 VIEW

PER = I / (2 * Q) ' CORRECT FOR PERSPECTIVE

FOR J = 0 TO Q - 1 ' FOR EACH PIXEL IN ROW

X11 = ((XCAL + PER) * J) + DISP: Y11 = ((YCAL + .3 * PER) * I) + YDIS

IF XDIR = 0 THEN AMP = C(T1, I, J) ELSE AMP = SQR(C(T1, I, J) ^ 2 + S(T1, I, J) ^ 2)' CALC "Z" AXIS

AMP = MAG2 * AMP

LINE (X11, Y11 + AMP)-(X11, Y11)

PRESET (X11, Y11 + AMP + 1)

NEXT J ' NEXT PIXEL

NEXT I ' NEXT ROW

RETURN ' ALL DONE





9999 END: STOP



10000 CLS ' ****   OPERATING INFORMATION   ****

PRINT : PRINT

PRINT "THIS 2-D TRANSFORM IS INTENDED FOR INSTRUCTIONAL PURPOSES.  IT DISPLAYS"

PRINT "THE HALF-TRANSFORMS AFTER PERFORMING THE 'ROW TRANSFORMS.'  PRESSING"

PRINT "ENTER THEN COMPLETES THE COLUMN TRANSFORMS AND THE FULL 2-D TRANSFORM"

PRINT "IS DISPLAYED.  THE FUNCTIONS ARE SELECTED TO MAKE THE OPERATION EASILY"

PRINT "APPARENT."

PRINT : PRINT

INPUT "ENTER TO CONTINUE"; A$

CLS : RETURN



